home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 090 / cmln0986.arc / INIT.MOD < prev    next >
Text File  |  1986-01-22  |  7KB  |  210 lines
  1.  
  2. (*-------------------------------------------------------INITIALIZE---*)
  3.  
  4. procedure INITIALIZE;
  5.  
  6. var I : INTEGER;
  7.     C :    CHAR;
  8.  
  9. begin
  10.  
  11. (*
  12.     =================
  13.      character types
  14.     =================
  15.  *)
  16.  
  17.   SPS['+'] := PLUS;        SPS['-'] := MINUS;
  18.   SPS['*'] := TIMES;       SPS['/'] := RDIV;
  19.   SPS['('] := LPARENT;     SPS[')'] := RPARENT;
  20.   SPS['='] := EQL;         SPS[','] := COMMA;
  21.   SPS['['] := LBRACK;      SPS[']'] := RBRACK;
  22.   SPS['"'] := NEQ;         SPS['&'] := ANDSY;
  23.   SPS[';'] := SEMICOLON;
  24.  
  25.   for C := CHR( ORDMINCHAR ) to CHR( ORDMAXCHAR ) do case C of
  26.  
  27.     'A'..'Z' : CHARTP[C] := LETTER;
  28.     'a'..'z' : CHARTP[C] := LOWCASE;
  29.     '0'..'9' : CHARTP[C] := NUMBER;
  30.  
  31.     '+', '-', '*', '/', '(', ')', '$', '=', ' ', ',',
  32.     '.', '''','[', ']', ':', '^', '_', ';', '{', '}',
  33.     '<', '>' : CHARTP[C] := SPECIAL;
  34.  
  35.     else CHARTP[C] := ILLEGAL;
  36.  
  37.   end;
  38.  
  39. (*
  40.     ===========
  41.        Sets
  42.     ===========
  43. *)
  44.  
  45.   CONSTBEGSYS := [ PLUS,MINUS,INTCON,REALCON,CHARCON,IDENT    ];
  46.   TYPEBEGSYS  := [ IDENT,ARRAYSY,RECORDSY                     ];
  47.   BLOCKBEGSYS := [ CONSTSY,TYPESY,VARSY,PROCSY,FUNCSY,BEGINSY ];
  48.   FACBEGSYS   := [ INTCON,REALCON,CHARCON,IDENT,LPARENT,NOTSY ];
  49.   STATBEGSYS  := [ BEGINSY,IFSY,WHILESY,REPEATSY,FORSY,CASESY ];
  50.   STANTYPS    := [ NOTYP,INTS,REALS,BOOLS,CHARS               ];
  51.  
  52. (*
  53.    ===========
  54.      Scalars
  55.    ===========
  56. *)
  57.  
  58.   LC := 0;
  59.   LL := 0;
  60.   CC := 0;
  61.   CH := ' ';
  62.   ERRPOS :=  0;
  63.   ERRS   := [];
  64.   T := -1;
  65.   A :=  0;
  66.   B :=  1;
  67.   SX := 0;
  68.   C2 := 0;
  69.   DISPLAY[0] := 1;
  70.   IFLAG := FALSE;
  71.   OFLAG := FALSE;
  72.   DFLAG := FALSE;
  73.   SKIPFLAG := FALSE;
  74.   LINECOUNT := -1;
  75.  
  76. end; { INITIALIZE }
  77.  
  78. procedure ENTERSTDFCNS;
  79.  
  80. (*--------------------------------------------------------ENTER-----
  81.    the following procedures enter the apropriate type
  82.    into the associated table for that type.
  83. *)
  84.  
  85.   procedure ENTER( X0: ALFA; X1: OBJECT; X2: TYPES; X3: INTEGER );
  86.   begin
  87.      T := T+1;       (* enter standard identifier *)
  88.      with TAB[T] do begin
  89.        NAME := X0;
  90.        LINK := T-1;
  91.        OBJ  := X1;
  92.        TYP  := X2;
  93.        REF  := 0;
  94.        NORMAL := TRUE;
  95.        LEV  := 0;
  96.        ADR  := X3;
  97.      end;
  98.   end; { ENTER }
  99.  
  100. begin
  101.   ENTER('          ',  VARIABLE, NOTYP,  0);
  102.   ENTER('FALSE     ',  KONSTANT, BOOLS,  0);
  103.   ENTER('TRUE      ',  KONSTANT, BOOLS,  1);
  104.   ENTER('REAL      ',     TYPE1, REALS,  1);
  105.   ENTER('CHAR      ',     TYPE1, CHARS,  1);
  106.   ENTER('BOOLEAN   ',     TYPE1, BOOLS,  1);
  107.   ENTER('INTEGER   ',     TYPE1, INTS ,  1);
  108.   ENTER('ABS       ',  FUNKTION, REALS,  0);
  109.   ENTER('SQR       ',  FUNKTION, REALS,  2);
  110.   ENTER('ODD       ',  FUNKTION, BOOLS,  4);
  111.   ENTER('CHR       ',  FUNKTION, CHARS,  5);
  112.   ENTER('ORD       ',  FUNKTION, INTS,   6);
  113.   ENTER('SUCC      ',  FUNKTION, CHARS,  7);
  114.   ENTER('PRED      ',  FUNKTION, CHARS,  8);
  115.   ENTER('ROUND     ',  FUNKTION, INTS,   9);
  116.   ENTER('TRUNC     ',  FUNKTION, INTS,  10);
  117.   ENTER('SIN       ',  FUNKTION, REALS, 11);
  118.   ENTER('COS       ',  FUNKTION, REALS, 12);
  119.   ENTER('EXP       ',  FUNKTION, REALS, 13);
  120.   ENTER('LN        ',  FUNKTION, REALS, 14);
  121.   ENTER('SQRT      ',  FUNKTION, REALS, 15);
  122.   ENTER('ARCTAN    ',  FUNKTION, REALS, 16);
  123.   ENTER('EOF       ',  FUNKTION, BOOLS, 17);
  124.   ENTER('EOLN      ',  FUNKTION, BOOLS, 18);
  125.   ENTER('RANDOM    ',  FUNKTION, INTS,  19);
  126.   ENTER('READ      ', PROZEDURE, NOTYP,  1);
  127.   ENTER('READLN    ', PROZEDURE, NOTYP,  2);
  128.   ENTER('WRITE     ', PROZEDURE, NOTYP,  3);
  129.   ENTER('WRITELN   ', PROZEDURE, NOTYP,  4);
  130.   ENTER('WAIT      ', PROZEDURE, NOTYP,  5);
  131.   ENTER('SIGNAL    ', PROZEDURE, NOTYP,  6);
  132.   ENTER('          ', PROZEDURE, NOTYP,  0);
  133. end; { ENTERSTDFCNS }
  134.  
  135. procedure ERRORMSG;
  136. const   MSG : array[0..60] of string[40] =
  137.           ( 'UNDEFINED IDENTIFIER',
  138.             'MULTIPLE DEFINITION OF THIS IDENTIFIER',
  139.             'EXPECTED AN IDENTIFIER',
  140.             'PROGRAM MUST begin WITH "PROGRAM"',
  141.             'EXPECTED CLOSING PARENTHESIS ")"',
  142. {  5 }      'EXPECTED A COLON ":"',
  143.             'INCORRECTLY USED SYMBOL',
  144.             'EXPECTED IDENTIFIER OR THE SYMBOL "VAR"',
  145.             'EXPECTED THE SYMBOL "OF"',
  146.             'EXPECTED AN OPENING PARENTHESIS "("',
  147. { 10 }      'EXPECTED IDENTIFER, "ARRAY" OR "RECORD"',
  148.             'EXPECTED AN OPENING BRACKET "["',
  149.             'EXPECTED A CLOSING BRACKET "]"',
  150.             'EXPECTED ".." WITHOUT INTERVENING BLANKS',
  151.             'EXPECTED A SEMICOLON ";"',
  152. { 15 }      'BAD RESULT TYPE FOR A FUNCTION',
  153.             'EXPECTED AN EQUAL SIGN "="',
  154.             'EXPECTED BOOLEAN EXPRESSION ',
  155.             'CONTROL VARIABLE OF THE WRONG TYPE',
  156.             'MUST BE MATCHING TYPES',
  157. { 20 }      '"OUTPUT" IS REQUIRED IN PROGRAM HEADING',
  158.             'THE NUMBER IS TOO LARGE',
  159.             'EXPECT PERIOD ".", CHECK begin-END PAIRS',
  160.             'BAD TYPE FOR A CASE STATEMENT',
  161.             'ILLEGAL CHARACTER',
  162. { 25 }      'ILLEGAL CONSTANT OR CONSTAT IDENTIFIER',
  163.             'ILLEGAL ARRAY SUBSCRIPT (CHECK TYPE)',
  164.             'ILLEGAL BOUNDS FOR AN ARRAY INDEX',
  165.             'INDEXED VARIABLE MUST BE AN ARRAY',
  166.             'EXPECTED A TYPE IDENFIFIER',
  167. { 30 }      'UNDEFINED TYPE',
  168.             'VAR WITH FIELD SELECTOR MUST BE RECORD',
  169.             'EXPECTED TYPE "BOOLEAN"',
  170.             'ILLEGAL TYPE FOR ARITHMETIC EXPRESSION',
  171.             'EXPECTED INTEGER FOR "DIV" OR "MOD"',
  172. { 35 }      'INCOMPATIBLE TYPES FOR COMPARISON',
  173.             'PARAMETER TYPES DO NOT MATCH',
  174.             'EXPECTED A VARIABLE',
  175.             'A STRING MUST HAVE ONE OR MORE CHAR',
  176.             'NUMBER OF PARAMETERS DO NOT MATCH',
  177. { 40 }      'ILLEGAL PARAMETERS TO "READ"',
  178.             'ILLEGAL PARAMETERS TO "WRITE"',
  179.             'PARAMETER MUST BE OF TYPE "REAL"',
  180.             'PARAMETER MUST BE OF TYPE "INTEGER"',
  181.             'EXPECTED VARIABLE OR CONSTANT',
  182. { 45 }      'EXPECTED A VARIABLE OR PROCEDURE',
  183.             'TYPES MUST MATCH IN AN ASSIGNMENT',
  184.             'CASE LABEL NOT SAME TYPE AS CASE CLAUSE',
  185.             'ARGUMENT TO STD. FUNCTION OF WRONG TYPE',
  186.             'THE PROGRAM REQUIRES TOO MUCH STORAGE',
  187. { 50 }      'ILLEGAL SYMBOL FOR A CONSTANT',
  188.             'EXPECTED BECOMES ":="',
  189.             'EXPECTED "THEN"',
  190.             'EXPECTED "UNTIL"',
  191.             'EXPECTED "DO"',
  192. { 55 }      'EXPECTED "TO" OR "DOWNTO"',
  193.             'EXPECTED "BEGIN"',
  194.             'EXPECTED "END"',
  195.             'EXPECTED ID, CONST, "NOT" OR "("',
  196.             '"INPUT"  IS REQUIRED IN PROGRAM HEADING',
  197. { 60 }      'CONTROL CHARACTER PRESENT IN SOURCE ');
  198.  
  199. var K : integer;
  200.  
  201. begin
  202.   K := 0;
  203.   writeln; writeln(' ERROR MESSAGE(S)');
  204.   while ERRS <> [] do begin
  205.     while NOT ( K in ERRS ) do K := K+1;
  206.     writeln( K:2,'  ',MSG[K] );
  207.     ERRS := ERRS - [K]
  208.   end;
  209. end; { ERRORMSG }
  210.